Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d13/pcroct89.arc/SEARCH.ARC/SEARCH.BAS

BASIC Source File | 1990-03-21 | 12KB | 510 lines

' $INCLUDE: 'QB.BI'
DEFINT A-Z

TYPE FoundType
    FileName  AS STRING * 72
    count     AS INTEGER
END TYPE

TYPE DTAType
    reserved  AS STRING * 21
    attrib    AS STRING * 1
    WriteTime AS INTEGER
    WriteDate AS INTEGER
    Size      AS LONG
    FileName  AS STRING * 13
END TYPE

CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST MaxExcl = 10
CONST Normal = 0
CONST Subdirectory = &H10

DECLARE SUB GetParms ()
DECLARE FUNCTION Prompt$ (Text$)
DECLARE SUB AddExclude (Ext$)
DECLARE SUB DelExclude (Ext$)
DECLARE FUNCTION Excluded% (Ext$)
DECLARE SUB FindFiles ()
DECLARE FUNCTION GetCurrentDir$ ()
DECLARE FUNCTION DOSFindFirst% (Spec$, attrib%)
DECLARE FUNCTION DOSFindNext% ()
DECLARE SUB SetDTA (DTA AS DTAType)
DECLARE SUB SearchFile (DTA AS DTAType)
DECLARE SUB Display (FileNum%, DisplayPosn&, FileLen&)
DECLARE SUB NicePrint (Text$)
DECLARE FUNCTION Strip8$ (Text$)
DECLARE SUB Finish ()

OPTION BASE 1
DIM SHARED FileSpec$, SearchText$, OutFile$
DIM SHARED Excl$(MaxExcl), ExclCount
DIM SHARED CurrDir$, OrigDir$
DIM SHARED Root, Subdirs, Bit8, Pause, FileOut, IgnoreCase, StatsOnly
DIM SHARED Matches(200) AS FoundType, MatchCount
DIM SHARED FilesSearched, MatchEntry
DIM SHARED InRegs AS RegType, OutRegs AS RegType
DIM SHARED InRegsX AS RegTypeX, OutRegsX AS RegTypeX

'   Set default options
Root = FALSE
Subdirs = FALSE
Bit8 = FALSE
IgnoreCase = TRUE
ExclCount = 0
Pause = TRUE
FileOut = FALSE
MatchCount = 0
StatsOnly = FALSE

'**********************
' Program starts here
'**********************

OrigDir$ = GetCurrentDir$
GetParms
IF IgnoreCase THEN
    SearchText$ = UCASE$(SearchText$)
END IF
IF FileOut THEN
    OPEN OutFile$ FOR OUTPUT AS #1
ELSE
    OPEN "SCRN:" FOR OUTPUT AS #1
END IF
IF Root THEN
    CHDIR "\"
END IF
FindFiles
Finish
END

'**********************
'  Get information from
'  the user
'**********************
SUB GetParms
    CLS
    PRINT "Enter file(s) to search.  You may use standard DOS wildcards."
    LINE INPUT "==> ", FileSpec$
    IF LEN(FileSpec$) = 0 THEN END
    IF INSTR(FileSpec$, ".") = 0 THEN
        FileSpec$ = FileSpec$ + ".*"
    END IF
    PRINT
    LINE INPUT "Enter text you want to find ==> ", SearchText$
    IF LEN(SearchText$) = 0 THEN END

    CLS
    LOCATE 2, 1
    PRINT "Output file: "
    PRINT "Excluded files: "
    LOCATE 5, 1
    PRINT "Enter number of option you want to change."
    PRINT "Press <RETURN> when you are done or <ESC> to end program"
    PRINT
    PRINT
    PRINT "       1. Include subdirectories in the search"
    PRINT "       2. Start search in root directory"
    PRINT "       3. Strip word processor control bits"
    PRINT "       4. Ignore case while searching"
    PRINT "       5. Exclude .EXE and .COM files from the search"
    PRINT "       6. Exclude other files from the search"
    PRINT "       7. Pause to display each match found"
    PRINT "       8. Report names of files with matches only"
    PRINT "       9. Send output to a file"
    DO
        LOCATE 9, 3
        IF Subdirs THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 10, 3
        IF Root THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 11, 3
        IF Bit8 THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 12, 3
        IF IgnoreCase THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 13, 3
        IF Excluded("EXE") AND Excluded("COM") THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 15, 3
        IF Pause THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 16, 3
        IF StatsOnly THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 17, 3
        IF FileOut THEN PRINT "++";  ELSE PRINT "  ";
        LOCATE 2, 14
        PRINT STRING$(65, " ");
        LOCATE 2, 14
        PRINT OutFile$
        LOCATE 3, 17
        PRINT STRING$(MaxExcl * 6, " ");
        LOCATE 3, 17
        FOR Lp = 1 TO ExclCount
            PRINT "*."; Excl$(Lp); " ";
        NEXT Lp
        LOCATE 17, 1
        DO
            Char$ = INPUT$(1)
        LOOP UNTIL INSTR(CHR$(13) + CHR$(27) + "123456789", Char$)
        SELECT CASE Char$
            CASE "1"
                Subdirs = Subdirs XOR TRUE
            CASE "2"
                Root = Root XOR TRUE
                IF Root THEN
                    Subdirs = TRUE
                END IF
            CASE "3"
                Bit8 = Bit8 XOR TRUE
            CASE "4"
                IgnoreCase = IgnoreCase XOR TRUE
            CASE "5"
                IF Excluded("EXE") THEN
                    DelExclude ("EXE")
                    DelExclude ("COM")
                ELSE
                    IF ExclCount + 2 <= MaxExcl THEN
                        AddExclude ("EXE")
                        AddExclude ("COM")
                    ELSE
                        Temp$ = Prompt$("Excluded file list is full")
                    END IF
                END IF
            CASE "6"
                FileExt$ = Prompt$("Enter file extension to add or remove from the list")
                FileExt$ = LTRIM$(RTRIM$(UCASE$(FileExt$)))
                WHILE INSTR(FileExt$, ".")
                    FileExt$ = MID$(FileExt$, INSTR(FileExt$, ".") + 1)
                WEND
                IF LEN(FileExt$) > 0 AND LEN(FileExt$) <= 3 THEN
                    IF Excluded(FileExt$) THEN
                        DelExclude (FileExt$)
                    ELSE
                        IF ExclCount < MaxExcl THEN
                            AddExclude (FileExt$)
                        ELSE
                            FileExt$ = Prompt$("Excluded file list is full")
                        END IF
                    END IF
                END IF
            CASE "7"
                Pause = Pause XOR TRUE
            CASE "8"
                StatsOnly = StatsOnly XOR TRUE
            CASE "9"
                FileOut = FileOut XOR TRUE
                IF FileOut THEN
                    OutFile$ = LTRIM$(RTRIM$(UCASE$(Prompt$("Name for output file"))))
                    IF LEN(OutFile$) = 0 THEN
                        FileOut = FALSE
                    ELSE
                        Pause = FALSE
                    END IF
                ELSE
                    OutFile$ = ""
                END IF
            CASE CHR$(27)
                END
            CASE ELSE
        END SELECT
    LOOP UNTIL Char$ = CHR$(13)
END SUB

FUNCTION Prompt$ (Text$)
    OrigLine = CSRLIN
    OrigPosn = POS(0)
    LOCATE 23, 1
    PRINT Text$;
    LINE INPUT " ==> ", Temp$
    LOCATE 23, 1
    FOR Lp = 1 TO LEN(Text$) + LEN(Temp$) + 5
        PRINT " ";
    NEXT Lp
    LOCATE OrigLine, OrigPosn
    Prompt$ = Temp$
END FUNCTION

'**********************
'  Maintain list of
'  excluded files
'**********************
SUB AddExclude (Ext$)
    IF Excluded(Ext$) = FALSE AND ExclCount < MaxExcl THEN
        ExclCount = ExclCount + 1
        Excl$(ExclCount) = Ext$
    END IF
END SUB

SUB DelExclude (Ext$)
    Found = FALSE
    FOR Lp = 1 TO ExclCount
        IF Excl$(Lp) = Ext$ THEN
            Found = TRUE
            FOR lp2 = Lp TO ExclCount - 1
                Excl$(lp2) = Excl$(lp2 + 1)
            NEXT lp2
        END IF
    NEXT Lp
    IF Found THEN
        ExclCount = ExclCount - 1
    END IF
END SUB

FUNCTION Excluded (Ext$)
    FOR Lp = 1 TO ExclCount
        IF Excl$(Lp) = Ext$ THEN
            Excluded = TRUE
            EXIT FUNCTION
        END IF
    NEXT Lp
    Excluded = FALSE
END FUNCTION

'**********************
'  Find files to seach
'**********************
SUB FindFiles
    DIM LocalDTA AS DTAType
    CALL SetDTA(LocalDTA)
    CurrentDIR$ = GetCurrentDir$
    IF DOSFindFirst(FileSpec$, Normal) THEN
        DO
            CALL SearchFile(LocalDTA)
        LOOP WHILE DOSFindNext
    END IF
    IF Subdirs THEN
        IF DOSFindFirst("*.*", Subdirectory) THEN
            DO
                IF LocalDTA.attrib$ = CHR$(Subdirectory) AND LEFT$(LocalDTA.FileName$, 1) <> "." THEN
                    CHDIR (LocalDTA.FileName$)
                    FindFiles
                    CALL SetDTA(LocalDTA)
                    CHDIR (CurrentDIR$)
                END IF
            LOOP WHILE DOSFindNext
        END IF
    END IF
END SUB

'**********************
'  DOS Support functions
'**********************
FUNCTION GetCurrentDir$
    InRegs.ax = &H1900
    CALL INTERRUPT(&H21, InRegs, OutRegs)
    Drive$ = CHR$((OutRegs.ax AND 255) + ASC("A")) + ":\"
    TempDir$ = STRING$(64, " ")
    InRegsX.ax = &H4700
    InRegsX.dx = 0
    InRegsX.ds = VARSEG(TempDir$)
    InRegsX.si = SADD(TempDir$)
    CALL interruptx(&H21, InRegsX, OutRegsX)
    TempDir$ = LEFT$(TempDir$, INSTR(TempDir$, CHR$(0)) - 1)
    GetCurrentDir$ = Drive$ + TempDir$
END FUNCTION

FUNCTION DOSFindFirst (Spec$, attrib%)
    Temp$ = Spec$ + CHR$(0)
    InRegsX.ax = &H4E00
    InRegsX.cx = attrib%
    InRegsX.ds = VARSEG(Temp$)
    InRegsX.dx = SADD(Temp$)
    CALL interruptx(&H21, InRegsX, OutRegsX)
    DOSFindFirst = ((OutRegsX.flags AND &H1) = 0)
END FUNCTION

FUNCTION DOSFindNext
    InRegs.ax = &H4F00
    CALL INTERRUPT(&H21, InRegs, OutRegs)
    DOSFindNext = ((OutRegs.flags AND &H1) = 0)
END FUNCTION

SUB SetDTA (DTA AS DTAType)
    InRegsX.ax = &H1A00
    InRegsX.ds = VARSEG(DTA)
    InRegsX.dx = VARPTR(DTA)
    CALL interruptx(&H21, InRegsX, OutRegsX)
END SUB

'**********************
' Search a file for text
' These routines make no
' assumptions about the
' file format
'**********************
SUB SearchFile (DTA AS DTAType)
    CONST BufLen = 8192
    MatchFlag = 0
    Posn = INSTR(DTA.FileName$, CHR$(0))
    IF Posn THEN
        File$ = LEFT$(DTA.FileName$, Posn - 1)
    ELSE
        File$ = DTA.FileName$
    END IF
    FOR Lp = 1 TO ExclCount
        IF INSTR(File$, "." + Excl$(Lp)) THEN
            EXIT SUB
        END IF
    NEXT Lp
    IF NOT FileOut THEN
        CLS
        PRINT #1, "Searching "; GetCurrentDir$ + "\" + File$
    ELSEIF NOT StatsOnly THEN
        PRINT #1, "Searching "; GetCurrentDir$ + "\" + File$
    END IF
    FileNum = FREEFILE
    OPEN File$ FOR BINARY AS FileNum
    FilesSearched = FilesSearched + 1
    FileLen& = DTA.Size
    FilePosn& = 1
    KeepLen = LEN(SearchText$) - 1
    FileBuf$ = STRING$(BufLen, 0)
    MatchFlag = FALSE
    DO WHILE FilePosn& < FileLen&
        SEEK FileNum, FilePosn&
        GET FileNum, , FileBuf$
        IF Bit8 THEN
            FileBuf$ = Strip8$(FileBuf$)
        END IF
        IF IgnoreCase THEN
            FileBuf$ = UCASE$(FileBuf$)
        END IF
        Posn = INSTR(FileBuf$, SearchText$)
        IF Posn THEN
            IF MatchFlag THEN
                Matches(MatchCount).count = Matches(MatchCount).count + 1
            ELSE
                MatchFlag = TRUE
                MatchCount = MatchCount + 1
                Temp$ = GetCurrentDir$ + "\" + File$
                Matches(MatchCount).FileName = Temp$
                Matches(MatchCount).count = 1
            END IF
            MatchEntry = MatchEntry + 1
            IF NOT (FileOut AND StatsOnly) THEN
                IF NOT (FileOut OR StatsOnly) THEN CLS
                PRINT #1, "In "; File$; " at byte"; FilePosn& + Posn - 1
                IF NOT (FileOut OR StatsOnly) THEN
                    CALL Display(FileNum, FilePosn& + Posn - 1, FileLen&)
                    IF Pause THEN
                        COLOR 0, 7
                        PRINT , "(C)ontinue, (N)ext File, (E)nd ==> ";
                        DO
                            Char$ = UCASE$(INPUT$(1))
                        LOOP UNTIL INSTR("CNE", Char$)
                        COLOR 7, 0
                        IF Char$ = "E" THEN
                            Finish
                        ELSEIF Char$ = "N" THEN
                            CLOSE FileNum
                            EXIT SUB
                        END IF
                    END IF
                END IF
            END IF
            FilePosn& = FilePosn& + Posn + KeepLen
        ELSE
            FilePosn& = FilePosn& + BufLen - KeepLen
        END IF
    LOOP
    CLOSE FileNum
END SUB

SUB Display (FileNum, DisplayPosn&, FileLen&)
    Prefix& = DisplayPosn& - 1
    IF Prefix& > 200 THEN Prefix& = 200
    IF Prefix& THEN
        Disp$ = STRING$(Prefix&, 32)
        StartPosn& = DisplayPosn& - Prefix&
        SEEK FileNum, StartPosn&
        GET FileNum, , Disp$
        IF Bit8 THEN
            Disp$ = Strip8$(Disp$)
        END IF
        NicePrint Disp$
    ELSE
        SEEK FileNum, 1
    END IF

    COLOR 0, 7
    Disp$ = SearchText$
    GET FileNum, , Disp$
    IF Bit8 THEN
        Disp$ = Strip8$(Disp$)
    END IF
    NicePrint Disp$
    COLOR 7, 0

    Suffix& = FileLen& - SEEK(FileNum) + 1
    IF Suffix& > 200 THEN Suffix& = 200
    IF Suffix& THEN
        Disp$ = STRING$(Suffix&, 32)
        GET FileNum, , Disp$
        IF Bit8 THEN
            Disp$ = Strip8$(Disp$)
        END IF
        NicePrint Disp$
    END IF
    NicePrint CHR$(13)
END SUB

SUB NicePrint (Text$)
    PrntPosn = 1
    DO
        Char$ = MID$(Text$, PrntPosn, 1)
        IF Char$ >= " " OR Char$ = CHR$(9) THEN
            PRINT #1, Char$;
            PrntPosn = PrntPosn + 1
        ELSEIF Char$ = CHR$(13) OR Char$ = CHR$(10) THEN
            PRINT #1,
            PrntPosn = PrntPosn + 1
            DO WHILE MID$(Text$, PrntPosn, 1) = CHR$(13) OR MID$(Text$, PrntPosn, 1) = CHR$(10)
                PrntPosn = PrntPosn + 1
            LOOP
        ELSE
            PRINT #1, ".";
            PrntPosn = PrntPosn + 1
        END IF
    LOOP UNTIL PrntPosn > LEN(Text$)
END SUB

FUNCTION Strip8$ (Text$)
    FOR Lp = 128 TO 255
        Char$ = CHR$(Lp)
        StrippedChar$ = CHR$(Lp AND 127)
        Posn = 1
        Ptr = INSTR(Posn, Text$, Char$)
        DO WHILE Ptr
            MID$(Text$, Ptr, 1) = StrippedChar$
            Posn = Posn + Ptr
            Ptr = INSTR(Posn, Text$, Char$)
        LOOP
    NEXT Lp
    Strip8$ = Text$
END FUNCTION

'**********************
' Report final statistics
'**********************
SUB Finish
    IF NOT FileOut AND NOT StatsOnly THEN
        CLS
    ELSE
        PRINT #1,
    END IF
    PRINT #1, SearchText$; " found in"; MatchCount; "of"; FilesSearched; "files"
    PRINT #1,
    IF MatchCount > 0 THEN
        PRINT #1, "Count  File Name"
        PRINT #1, "=====  ========="
        FOR Lp = 1 TO MatchCount
            PRINT #1, USING "#####  "; Matches(Lp).count;
            PRINT #1, Matches(Lp).FileName
        NEXT Lp
    END IF
    CLOSE
    IF Root THEN
        CHDIR OrigDir$
    END IF
    END
END SUB